Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/StandardGetFolder/StandardGetFolder.p

Text File | 1992-12-18 | 16.3 KB | 342 lines | [TEXT/PJMM]

{******************************************************************************}
{ StandardGetFolder.c                                                          }
{                                                                              }
{    This little chunk o' code implements a way to let the user choose a       }
{    folder to save files in via a StandardFile Dialog.                        }
{                                                                              }
{    Since the code uses the CustomGetFile function and depends on the use of  }
{    FSSpec records, it only works under System 7.0 or later.                  }
{                                                                              }
{    And don't forget to include the custom dialog resources ( a 'DITL' and    }
{   'DLOG') in your project.                                                   }
{                                                                              }
{    Portions of this code were originally provided by Paul Forrester          }
{    ([e-mail]) to the think-c internet mailing list in response to my  }
{    my question on how to do exactly what this code does.  I've added a       }
{    couple of features, such as the ability to handle aliased folders and     }
{    the programmer definable prompt.  I also cleaned and tightened the code,  }
{    stomped a couple of bugs, and packaged it up neatly.  Bunches of work,    }
{    but I learned A LOT about Standard File, the File Manager, the Dialog     }
{    Manager, and the Alias Manager.  I tried to include in the comments some  }
{    of the neat stuff I discovered in my hours of pouring over Inside Mac.    }
{    Hope you find it educational as well as useful.                           }
{******************************************************************************}
{ Converted to Pascal by Peter N Lewis <[e-mail]> Dec 1992 }

unit StandardGetFolder;

interface

    function GetSFCurDir: longInt;
    function GetSFVRefNum: integer;
    procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);

implementation

    uses
        Aliases, Script;

{ Resource IDs }
    const
        rGetFolderButton = 10;
        rGetFolderMessage = 11;
        kFolderBit = $0010;
        rGetFolderDialog = 2008;

{ Global Variables }

    var
        gCurrentSelectedFolder: str255;


{******************************************************************************}
{ SetButtonTitle                                                               }
{                                                                              }
{     Whenever the selected folder is changed, SetButtonTitle is called to     }
{     redraw the get folder button.  Pass it a handle to the button, the new   }
{     string to be drawn in the button, and a pointer to the rect the button   }
{     is drawn within.                                                         }
{******************************************************************************}
    procedure SetButtonTitle (ButtonHdl: Handle; name: Str255; var ButtonRect: Rect);
        var
            resultCode: integer;
            width: integer;
            TmpStr: str255;

    begin
        gCurrentSelectedFolder := name;

    {*-------------------------------------------------------------------------}
    { Find the width left over in the button after drawing the word 'Select'   }
    { the quotation marks. Truncate the new name to this length.               }
    {-------------------------------------------------------------------------*}
        width := (ButtonRect.right - ButtonRect.left) - (StringWidth('Select ""J'));

        resultCode := TruncString(width, name, smTruncEnd);
        if resultCode < 0 then
            ;

    {*-------------------------------------------------------------------------}
    { Redraw the button.                                                       }
    {-------------------------------------------------------------------------*}
        TmpStr := concat('Select "', name, '"');
        SetCTitle(ControlHandle(ButtonHdl), TmpStr);
        ValidRect(ButtonRect);
    end;


{******************************************************************************}
{ MyCustomGetDirectoryFileFilter                                               }
{                                                                              }
{     This is the file filter passed to CustomGetFile. It passes folders only. }
{******************************************************************************}
    function MyCustomGetDirectoryFileFilter (var myPB: CInfoPBRec; myDataPtr: Ptr): boolean;
    begin
        MyCustomGetDirectoryFileFilter := BAND(myPB.ioFlAttrib, kFolderBit) = 0;
    end;


{******************************************************************************}
{ MyCustomGetDirectoryDlogHook                                                 }
{                                                                              }
{     This function lets us process item hits in the GetFolderDialog.  We're   }
{     only interested if the user hit the selectFolder button. We pass all     }
{     other item hits back to ModalDialog.                                     }
{******************************************************************************}

    function MyCustomGetDirectoryDlogHook (item: integer; theDialog: DialogPtr; myDataPtr: Ptr): integer;
        type
            StandardFileReplyPtr = ^StandardFileReply;
        var
            dlgPeek: WindowPeek;
            selectedName: Str255;
            pb: CInfoPBRec;
            err: OSErr;
            itemType: integer;
            itemRect: Rect;
            itemHandle: Handle;
            isAlias: Boolean;
            isFolder: Boolean;
            mySFRPtr: StandardFileReplyPtr;
    begin

    {*-------------------------------------------------------------------------}
    { Set the return value to defualt to the item that was passed in.          }
    {-------------------------------------------------------------------------*}
        MyCustomGetDirectoryDlogHook := item;

    {*-------------------------------------------------------------------------}
    { CustomGet calls dialog hook for both main and subsidiary dialog boxes.   }
    { Make sure that dialog record indicates that this is the main GetFolder   }
    { dialog.                                                                  }
    {-------------------------------------------------------------------------*}
        dlgPeek := WindowPeek(theDialog);
        if OSType(dlgPeek^.refCon) = sfMainDialogRefCon then begin

        {*---------------------------------------------------------------------}
        { Get a handle to the select folder button, in case we need to change  }
        { the label.                                                           }
        {---------------------------------------------------------------------*}
            GetDItem(theDialog, rGetFolderButton, itemType, itemHandle, itemRect);

        {*---------------------------------------------------------------------}
        { If this is the first time the dialog hook has been called...         }
        {---------------------------------------------------------------------*}
            if item = sfHookFirstCall then begin

            {*-----------------------------------------------------------------}
            { Set the prompt displayed above the file list...                  }
            {-----------------------------------------------------------------*}
                GetDItem(theDialog, rGetFolderMessage, itemType, itemHandle, itemRect);
                mySFRPtr := StandardFileReplyPtr(myDataPtr);
                SetIText(itemHandle, mySFRPtr^.sfFile.name);

            {*-----------------------------------------------------------------}
            { And the name of the currently selected folder in the select      }
            { folder button.                                                   }
            {-----------------------------------------------------------------*}
                pb.ioNamePtr := @selectedName;
                pb.ioVRefNum := GetSFVRefNum;
                pb.ioDirID := GetSFCurDir;
                pb.ioFDirIndex := -1;
                err := PBGetCatInfo(@pb, FALSE);

            {*-----------------------------------------------------------------}
            { Note that this error return is important! When the dialog hook   }
            { is called for the first time, Super Boomerang (and possibly      }
            { Norton directory assistance aren't finished doing their          }
            { rebounting, so the values returned by GetSFVRefNum and           }
            { GetSFCurDir may not be valid, and hence PBGetCatInfo will return }
            { an error.  That one took me a while to figure out.               }
            {-----------------------------------------------------------------*}
                if err <> noErr then begin
                    exit(MyCustomGetDirectoryDlogHook);
                end;

                GetDItem(theDialog, rGetFolderButton, itemType, itemHandle, itemRect);
                SetButtonTitle(itemHandle, selectedName, itemRect);
            end
            else begin
            {*-----------------------------------------------------------------}
            { Cast myDataPtr back to a SFReply pointer.                        }
            {-----------------------------------------------------------------*}
                mySFRPtr := StandardFileReplyPtr(myDataPtr);


            {*-----------------------------------------------------------------}
            { If the selected folder is an alias, resolve it. isFolder will    }
            { be set to true if a folder or aliased folder is selected.        }
            {-----------------------------------------------------------------*}
             {*-----------------------------------------------------------------}
            { If the selected item is a folder or volume, just copy the name   }
            { into selectedName...                                             }
            {-----------------------------------------------------------------*}
                err := ResolveAliasFile(mySFRPtr^.sfFile, TRUE, isFolder, isAlias);
                if ((err = noErr) and isAlias and isFolder) or mySFRPtr^.sfIsFolder or mySFRPtr^.sfIsVolume then begin
                    selectedName := mySFRPtr^.sfFile.name;

            {*-----------------------------------------------------------------}
            { Otherwise, copy the name of the selected item's parent directory }
            { into selectedName.                                               }
            {-----------------------------------------------------------------*}
                end
                else begin

                    pb.ioNamePtr := @selectedName;
                    pb.ioVRefNum := mySFRPtr^.sfFile.vRefNum;
                    pb.ioDirID := mySFRPtr^.sfFile.parID;
                    pb.ioFDirIndex := -1;
                    err := PBGetCatInfo(@pb, FALSE);
                    if err <> noErr then
                        exit(MyCustomGetDirectoryDlogHook);
                end;

            {*-----------------------------------------------------------------}
            { If the selected folder has changed since the last call to this   }
            { dialog hook function, re-draw the button with the new selected   }
            { folder name.                                                     }
            {-----------------------------------------------------------------*}
                if not EqualString(selectedName, gCurrentSelectedFolder, FALSE, FALSE) then
                    SetButtonTitle(itemHandle, selectedName, itemRect);

            {*-----------------------------------------------------------------}
            { If the user clicked the select folder button, force a cancel and }
            { set the sfGood field of the Reply record to true.                }
            {-----------------------------------------------------------------*}
                if item = rGetFolderButton then begin

                    MyCustomGetDirectoryDlogHook := sfItemCancelButton;
                    mySFRPtr^.sfGood := TRUE;
                end;

            end;
        end;
    end;


{******************************************************************************}
{ StandardGetFolder                                                            }
{                                                                              }
{     The StandardGetFolder function. You pass it the point where you want the }
{     standard file dialog box drawn, the prompt to display above the file     }
{     list, and a pointer to an StandardFileReply record.                      }
{                                                                              }
{     Upon return, the sfFile field of the SFReply record contains the volume  }
{     reference number and directory ID that specify the folder the user       }
{     chose. It also passes back the name of the chosen folder.  The sfGood    }
{     field is set to true if the user chose a folder, or false if not.        }
{******************************************************************************}

    procedure StandardGetFolder (where: Point; message: Str255; var mySFReply: StandardFileReply);
        var
            theTypeList: SFTypeList;
            numTypes: integer;
            myModalFilter: ProcPtr;
            pb: CInfoPBRec;
            err: OSErr;
            theItem: integer;

    begin

    {*-------------------------------------------------------------------------}
    { Setting num types to -1 tells CustomGetFile to pass all files and        }
    { folders to the file filter function.                                     }
    {-------------------------------------------------------------------------*}
        numTypes := -1;

    {*-------------------------------------------------------------------------}
    { Copy the prompt to be displayed above the file list into the name field  }
    { of the SFReply record. When MyCustomGetDirectoryDlogHook is called for   }
    { the first time, it will use this info to draw the prompt.                }
    {-------------------------------------------------------------------------*}
        mySFReply.sfFile.name := message;

    {*-------------------------------------------------------------------------}
    { Call CustomGetFile. Pass it a pointer to the file filter and dialog      }
    { hook functions. Also pass a pointer to mySFReply in the user data field. }
    {-------------------------------------------------------------------------*}
        CustomGetFile(@MyCustomGetDirectoryFileFilter, numTypes, theTypeList, mySFReply, rGetFolderDialog, where, @MyCustomGetDirectoryDlogHook, nil, nil, nil, @mySFReply);

    {*-------------------------------------------------------------------------}
    { Ok, now the reply record contains the volume reference number and the    }
    { name of the selected folder. We need to use PBGetCatInfo to get the      }
    { directory ID of the selected folder.                                     }
    {-------------------------------------------------------------------------*}
        if mySFReply.sfGood then begin { Don't call PBGetCatInfo on cancel! }

            pb.ioNamePtr := @mySFReply.sfFile.name;
            pb.ioVRefNum := mySFReply.sfFile.vRefNum;
            pb.ioFDirIndex := 0;
            pb.ioDirID := mySFReply.sfFile.parID;

            err := PBGetCatInfo(@pb, FALSE);

    {*-------------------------------------------------------------------------}
    { Insert your error handler here. I couldn't think of one so I left it     }
    { empty. Works fine without it.                                            }
    {-------------------------------------------------------------------------*}
            if err <> noErr then
                ;

    {*-------------------------------------------------------------------------}
    { Copy the directory ID of the selected folder to the sfFile field of the  }
    { SFReply record.                                                          }
    {-------------------------------------------------------------------------*}
            mySFReply.sfFile.parID := pb.ioDrDirID;
            mySFReply.sfFile.name := '';
        end;

    end;



{******************************************************************************}
{ GetSFCurDir, GetSFVRefNum                                                    }
{                                                                              }
{ The following set of routines are used to access a couple of low memory      }
{ globals that are necessary when extending Standard File.  One example is     }
{ trying to get the current directory while in a file filter.  These routines  }
{ were used to bottleneck all the low memory usage.  If the system one day     }
{ supports them with a trap call, then we can easily update these routines.    }
{******************************************************************************}

    function GetSFCurDir: longInt;
        const
            CurDirStoreA = $398;
        type
            longPtr = ^longInt;
    begin
        GetSFCurDir := longPtr(CurDirStoreA)^;
    end;


    function GetSFVRefNum: integer;
        const
            SFSaveDiskA = $214;
        type
            intPtr = ^integer;
    begin
        GetSFVRefNum := -intPtr(SFSaveDiskA)^;
    end;

end.